home *** CD-ROM | disk | FTP | other *** search
/ POINT Software Programming / PPROG1.ISO / pascal / swag / graphics.swg / 0153_Partial Screen Fades.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1995-03-26  |  2.7 KB  |  106 lines
  1. Program Cheap_Cross_Fading;
  2. Uses CRT;
  3.  
  4. {
  5.   Here's a cheap cross fading routine I did some time ago. I cleaned it up,
  6.   optimized a few parts, and made it look pretty. <g>.
  7.  
  8.   Use or abuse at will, just, as always, throw me a greet in your scrolltext
  9.   of doc files. Greet me as Dr. Nibble. Or if you dislike handles for some
  10.   anal reason, greet me as David Proper.
  11. }
  12.  
  13. Const
  14.  Bits : array[1..8] of byte = ($80,$40,$20,$10,$08,$04,$02,$01);
  15.  
  16.  MaxText = 6;
  17.  TextList : Array[1..MaxText] of String[30] = (
  18.             ' Dr. Nibble of',
  19.             '    Daemon',
  20.             '   presents',
  21.             '   a cheap',
  22.             ' crossfading',
  23.             '   routine');
  24.  
  25. var
  26.  Counter : integer;
  27.  CH      : char;
  28.  Loop    : integer;
  29.  Di     : byte;
  30.  
  31.  
  32. Procedure GTxT(Xp,Yp, Color : Integer; Line : String; Fseg,Fofs: word;
  33.                FYS : integer);
  34. Var
  35.  Loop  : Byte;
  36.  X     : Integer;
  37.  Y     : Integer;
  38.  
  39. begin
  40.  For Loop := 1 to Length(line) do
  41.   For Y := 1 to FYS do
  42.    For X := 1 to 8 do
  43.     {$R-}
  44.     If MEM[Fseg:Fofs+(Y-1)+ord(Line[Loop])*FYS] and bits[X] <> 0 then
  45.      if Mem[$A000:(Loop*9)+(X+Xp)+(320*(Y+Yp))] = di then
  46.         Mem[$A000:(Loop*9)+(X+Xp)+(320*(Y+Yp))] := 3 else
  47.         Mem[$A000:(Loop*9)+(X+Xp)+(320*(Y+Yp))] := Color
  48.     {$R+}
  49. end;
  50.  
  51.  
  52. Procedure SetColor(C,R,G,B : Byte);
  53.  Begin
  54.   Port[$3C8] := C; Port[$3C9] := R; Port[$3C9] := G; Port[$3C9] := B;
  55.  End;
  56.  
  57. Procedure VideoMode(Mode : Byte);
  58.  Begin
  59.   Asm
  60.    Mov  AH,00
  61.    Mov  AL,Mode
  62.    Int  10h
  63.   End;
  64.  End;
  65.  
  66.  
  67. BEGIN
  68.  VideoMode($13);
  69.  DI := 2;
  70.  Counter := 1;
  71.  
  72.  
  73. repeat
  74.  FillChar(mem[$A000:0],$ffff,#0);
  75.  SetColor(1,0,0,0); SetColor(2,1,0,0); SetColor(3,1,0,0);
  76.  DI := 2;
  77.  GTxT(90,90,1,TextList[Counter+1],$F000,$FA6E,8);
  78.  dec(di); if di = 0 then di := 2;
  79.  GTxT(90,90,2,TextList[Counter],$F000,$FA6E,8);
  80.  for loop := 1 to 63 do begin
  81.                          SetColor(2,loop,0,0);
  82.                          SetColor(3,loop,0,0);
  83.                          delay(20);
  84.                         end;
  85.  delay(400);
  86.  for loop := 1 to 63 do begin
  87.                          SetColor(1,loop,0,0);
  88.                          SetColor(2,63-loop,0,0);
  89.                          if loop < 32 then SetColor(3,63-loop,0,0)
  90.                                       else SetColor(3,loop,0,0);
  91.                          delay(20);
  92.                         end;
  93.  delay(400);
  94.  for loop := 1 to 63 do begin
  95.                          SetColor(1,63-loop,0,0);
  96.                          SetColor(3,63-loop,0,0);
  97.                          Delay(20);
  98.                         end;
  99.  inc(Counter,2); if counter > MaxText then counter := 1;
  100. until keypressed;
  101.  
  102.  ch := readkey;
  103.  VideoMode(3);
  104. END.
  105.  
  106.